home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
menus
/
toadmenu.zip
/
MENU.INC
< prev
next >
Wrap
Text File
|
1987-10-30
|
11KB
|
367 lines
{menu.inc}
(*
Copyright (C) David P Kirschbaum All Rights Reserved
*)
PROCEDURE Window_Frame(x1,y1, x2,y2 : INTEGER);
{Create, frame and title a window}
VAR
x,
center : INTEGER;
BEGIN
Window(1,1,80,25);
Box(PRED(x1), PRED(y1), SUCC(x2), SUCC(y2), WHITE, double);
center := ((x2 - x1) SHR 1) + x1;
x := center - (LENGTH(MenuTitle) SHR 1);
IF ODD(center) AND FALSE
THEN x := PRED(x);
GotoXY(x, PRED(y1) );
IF Color THEN BEGIN
TextColor(WHITE);
TextBackGround(RED);
END
ELSE RvsOn;
WRITE(MenuTitle);
RvsOff;
Window(x1,y1,x2,y2);
ClrScr;
END; {of Window_Frame}
PROCEDURE Lower_Window(Openw : BOOLEAN);
BEGIN
IF Openw THEN BEGIN {open it}
Window(t_x, SUCC(T_Y), t_x+maxtxtlen, 23); {open window at screen base}
ClrScr;
GotoXY(1,1);
END
ELSE {close one already open}
Window(m_x, M_Y, m_x + maxitemlen, PRED(T_Y));
END; {of Lower_Window}
PROCEDURE Show_Cmd(Cmd : Str80);
BEGIN
IF Cmd[1] = '*' THEN Delete(Cmd,1,1); {gobble asterisks}
len := LENGTH(Cmd);
IF Cmd[len] = '%' THEN Delete(Cmd,len,1); {gobble %}
GotoXY(1,2); {reposition to overwrite}
Write( Centered(maxtxtlen,Cmd) ); {write new cmd string}
END; {of Show_Cmd}
PROCEDURE Get_Cmd;
VAR TCmd : Str40;
BEGIN {Get_Cmd}
len := LENGTH(Cmd[menuptr]);
IF Cmd[menuptr][len] <> '%'
THEN BEGIN {no user command parms permitted}
CmdParm := Cmd[menuptr]; {return cmd string if any}
Exit;
END;
Lower_Window(TRUE); {open window at screen base}
Writeln( Centered(maxtxtlen, Txt[menuptr]) );
CmdParm := Copy(Cmd[menuptr],1,PRED(len));
Show_Cmd(CmdParm);
GotoXY(1,3); {3d line for cmd parms}
Write('Enter Command Parameters: ');
Cursor(on);
Readln(TCmd);
Cursor(off);
GotoXY(1,1);
IF TCmd <> '' {got an entry}
THEN CmdParm := CmdParm {build new DOS cmd string}
+ ' ' + TCmd;
Show_Cmd(CmdParm); {display new cmd string}
Lower_Window(FALSE); {close it again}
END; {of Get_Cmd}
PROCEDURE Do_CmdStuff(p : INTEGER);
BEGIN
Lower_Window(TRUE); {open window at screen base}
Write( Centered(maxtxtlen, Txt[p]) );
Show_Cmd(Cmd[p]); {display DOS command}
Lower_Window(FALSE); {close lower window}
END; {of Do_CmdStuff}
PROCEDURE Repaint(p : INTEGER; Highlighted : BOOLEAN);
{Display the (menuptr) item on the menu screen,
highlighted (current) or normal (last).
}
BEGIN
IF Highlighted THEN BEGIN {highlight the current menu item}
IF Color THEN BEGIN
TextBackGround(BLUE);
TextColor(LIGHTGRAY);
END
ELSE RvsOn;
END
ELSE BEGIN {UNHIGHLIGHT THE OLD SELECTION}
IF Color THEN BEGIN
TextBackGround(BLACK);
TextColor(CYAN);
END
ELSE RvsOff;
END;
IF NOT FirstMenu THEN y := p - 9
ELSE y := SUCC(p);
IF LENGTH(FKey[y]) <= 2 THEN x := 4
ELSE x := 5;
GotoXY( x, y ); WRITE(' '); {blank out after FKey}
IF x = 4 THEN WRITE(' ');
WRITE(Item[p]); {Write menu entry}
ClrEol; {blank rest of item line}
GotoXY( 6 + hlcharpos[p],y );
IF Highlighted THEN BEGIN
IF NOT Color THEN TextBackGround(BLACK); {reverse key character}
TextColor(WHITE);
END
ELSE TextColor(LIGHTCYAN);
WRITE(HlChar[p]);
IF HighLighted {just went active ...}
THEN Do_CmdStuff(p); {so show DOS cmd & text}
END; {of Repaint}
PROCEDURE New_Menu;
{Repaint current menu}
BEGIN
IF FirstMenu THEN BEGIN
minptr := 1 ;
maxptr := 10
END
ELSE BEGIN
minptr := 11 ;
maxptr := menulen;
END;
{DISPLAY THE ACTUAL MENU SELECTIONS}
FOR menuptr := minptr TO maxptr DO BEGIN
IF FirstMenu THEN y := SUCC(menuptr)
ELSE y := menuptr - 9;
GotoXY( 2, y );
TextColor(BLACK);
TextBackGround(LIGHTGRAY);
IF FirstMenu THEN x := menuptr
ELSE x := menuptr - 10;
WRITE(FKey[x]);
hlcharpos[menuptr] :=
POS(HlChar[menuptr],Item[menuptr]);
Repaint(menuptr, FALSE); {unhighlighted}
END; {menuptr loop}
{IF MORE THAN 10 OPTIONS, PRINT NOTICE OF "MORE"}
IF LenOver10 THEN BEGIN
RvsOn;
GotoXY(2, T_Y - M_Y); WRITE(Legend);
RvsOff;
END;
IF FirstMenu THEN menuptr := default
ELSE menuptr := menulen;
END; {of New_Menu}
PROCEDURE Setup_Screen;
BEGIN
Cursor(off);
Box(PRED(t_x), T_Y, {frame bottom window}
SUCC(t_x + maxtxtlen), 24,
WHITE, double);
GotoXY(1,25);
TextColor(LIGHTGRAY);
IF Color THEN TextBackGround(BLUE)
ELSE RvsOn;
WRITE(' ',#24,'-',#25,
'-move bar. Select by pressing a highlighted letter,',
' a function key, or ',#17,#196,#217,' ');
IF Color THEN TextColor(WHITE);
GotoXY(37,25);
WRITE('highlighted');
GotoXY(59,25);
WRITE('function key');
TextColor(BLACK); TextBackGround(LIGHTGRAY);
GotoXY(2,25); WRITE(#24);
GotoXY(4,25); WRITE(#25);
GotoXY(76,25); WRITE(#17,#196,#217);
NormVideo;
Window_Frame
( m_x, M_Y, (m_x + maxitemlen), PRED(T_Y) );
New_Menu; {paint full menu}
END; {of Setup_Screen}
PROCEDURE Init_Menu;
{Initialize stuff}
BEGIN
GetDir(0,CurrentDir); {get current drive, directory,
save in global }
{pick up our current screen (color or mono), set global Color
boolean to TRUE (color) or FALSE (mono).
}
x_scrn := PTR(screen_location,0);
y_scrn := PTR(screen_location,0);
oldcolor := PALLETTE; {remember user's colors}
LenOver10 := (menulen > 10); {we use this often to remember
if we have 2 menus}
InChar := ' '; {INITIALIZE VARIABLES}
FirstMenu := TRUE;
Legend := '';
IF LenOver10 THEN
Legend := Centered(PRED(maxitemlen),'more' + #196 + #16 + 'spacebar');
{ CALCULATE AND FRAME WINDOW }
m_x := (80 - maxitemlen) SHR 1; {first the item menu window}
IF (ODD(maxitemlen)) AND FALSE
THEN m_x := SUCC(m_x);
t_x := (80 - maxtxtlen) SHR 1; {now text window}
IF Odd(t_x) THEN t_x := PRED(t_x);
END; {of Init_Menu}
FUNCTION Check_Key (Func : BOOLEAN): BOOLEAN;
{He hit a function or other key, see if in our legal range.
IF Func is TRUE, we check for function keys, otherwise
see if the char is in our item chars.
}
BEGIN
Check_Key := TRUE; {assume true}
IF Func THEN len := POS(Inchar,SecKey) {check for func keys}
ELSE len := POS(Upcase(InChar), {check for chars}
Copy(HlChar,minptr,255) );
IF (len <> 0) AND (NOT FirstMenu)
THEN len := len + 10; {bump to second menu}
IF (len < minptr) OR (len > maxptr) THEN BEGIN
Write(^G); {dummy}
Check_Key := FALSE;
END
ELSE menuptr := len; {post global}
END; {of Check_Key}
PROCEDURE Check_Range;
{Insure menuptr is in correct range}
BEGIN
IF menuptr > maxptr {went beyond bottom}
THEN menuptr := minptr {back to top}
ELSE IF menuptr < minptr {went beyond top}
THEN menuptr := maxptr; {so go to end}
END; {of Check_Range}
PROCEDURE Switch_Menu;
{Switch from current menu to the other one}
BEGIN
ClrScr;
FirstMenu := NOT FirstMenu;